perm filename M11B.F4[M11,LCS]6 blob
sn#426300 filedate 1979-03-15 generic text, type T, neo UTF8
CGEN1 FUNCTION GENERATOR 1 (SEG) *** MUSIC V ***
SUBROUTINEGEN1
COMMON I(1)/P/ P(1) /GENS/GENS(1)
1 /LFUNC/LFUNC
N1=1+(IFIX(P(4))-1)*LFUNC
M1=7
102 M=M1+1
IF(P(M).LE.0)GO TO 103
V1=P(M1-2)
V2=(P(M1)-P(M1-2))/(P(M)-P(M1-1))
MA=N1+IFIX(P(M1-1))
MB=N1+IFIX(P(M))-1
DO 101 J=MA,MB
XJ=J-MA
101 GENS(J)=V1+V2*XJ
IF(IFIX(P(M)).EQ.(LFUNC-1))GO TO 103
M1=M1+2
GO TO 102
103 GENS(MB+1)=P(M1)
RETURN
END
CGEN2 FUNCTION GENERATOR 2 (SYNTH) *** MUSIC V ***
SUBROUTINEGEN2
COMMON I(1)/P/ P(1) /GENS/GENS(1)
1 /LFUNC/LFUNC
N1=1+(IFIX(P(4))-1)*LFUNC
N2=N1+LFUNC-1
DO 101 K1=N1,N2
101 GENS(K1)=0.0
FAC=6.283185/(FLOAT(LFUNC)-1.0)
NMAX=I(1)
N3=5+INT(ABS(P(NMAX)))-1
IF(N3-5.LT.0)GO TO 104
DO 103 J=5,N3
FACK=FAC*FLOAT(J-4)
DO 102 K=N1,N2
102 GENS(K)=GENS(K)+SIN(FACK*FLOAT(K-N1))*P(J)
103 CONTINUE
104 N4=N3+1
N5=I(1)-1
IF(N5-N4.LT.0)GO TO 114
DO 107 J1=N4,N5
FACK=FAC*FLOAT(J1-N4)
DO 106 K1=N1,N2
106 GENS(K1)=GENS(K1)+COS(FACK*FLOAT(K1-N1))*P(J1)
107 CONTINUE
114 IF(P(NMAX).LE.0)GO TO 112
FMAX=0.0
DO 110 K2=N1,N2
A=ABS(GENS(K2))
110 IF(FMAX.LT.A)FMAX=A
113 DO 111 K3=N1,N2
111 GENS(K3)=GENS(K3)/FMAX
RETURN
112 FMAX=.99999
GO TO 113
END
CPARM CONTROL DATA SPECIFICATION FOR PASS 3 *** MUSIC V ***
C IP(1) = NUMBER OF OP CODES
C IP(2) = BEGINNING SUBSCRIPT OF FIRST FUNCTION
C IP(3) = STANDARD SAMPLING RATE
C IP(4) = BEGINNING SUBSCRIPT OF INSTRUMENT DEFINITIONS
C IP(5) = BEGINNING OF LOCATION TABLE FOR INSTRUMENT DEFINITIONS
C IP(6) = LENGTH OF FUNCTIONS
C IP(7) = BEGINNING OF NOTE CARD PARAMETERS
C IP(8) = LENGTH OF NOTE CARD PARAMETER BLOCKS
C IP(9) = NUMBER OF NOTE CARD PARAMETER BLOCKS
C IP(10)= BEGINNING OF OUTPUT DATA BLOCK
C IP(11)= SOUND ZERO (SILENCE VALUE)
C IP(12)= SCALE FACTOR FOR NOTE CARD PARAMETERS
C IP(13)= BEGINNING OF GENERATOR INPUT-OUTPUT BLOCKS
C IP(14)= LENGTH OF GENERATOR INPUT-OUTPUT BLOCKS
C IP(15)= SCALE FACTOR FOR FUNCTIONS
C
CS BLOCK DATA
CS COMMON /PARM/IP(20)
CS DATA IP/12,512,10000, 7100, 7000,512, 6000,35,27,4487,2048,
CS 1 10 ,4487,512, "77777 ,5*0/
CCC DATA IP/12,512,10000,14500,14400,512,13000,35,40,6657,2048,
CCC 1 "1000000,6657,512,"377777777777,5*0/
C*****BIG NUMB. IS IBM360'S BIGGEST. 1 65536,6657,512,Z7FFFFFFF/
CS END
CDSMOUT DEBUG SAMOUT 'C////'=CHANGES FOR PDP11 VERSION *** MUSIC V ***
SUBROUTINE SAMOUT(IDSK,N)
COMMON I(1) /ROUT/ROUT(1) /FINOUT/PEAK,IPEAK,NBUF
1 /CONV/CONV,INIOUT,JFLNM /IDEV/IDEV
DIMENSION IDBUF(2048),JDBUF(512),NN(512),LDBUF(512)
EQUIVALENCE (IDBUF,JDBUF),(LDBUF,IDBUF(513))
C*** IDBUF WILL STORE PACKED SAMPLES. ****
IF(INIOUT.EQ.0)GO TO 99
C NOW OPEN PROPER OUTPUT FILE
INIOUT=0
IDSK=0
IF(CONV.EQ.0)GO TO 199
C CALL PUTFILE('11')
CALL PUTEXT('TEST','SND')
NN(1)="525252525252
NN(2)=I(4)
C I(4)=SRATE, I(8)=NCHNS(-1), FOR NEXT, 0=12 BIT, 1=18 BIT SMPLS.
NN(3)="3000001
NN(4)=I(8)+1
NN(5)=64000
DO 299 K=6,128
299 NN(K)=0
C CALL FASTOU(NN,128)
CALL EXTOUT(NN,128)
GO TO 99
C OUTPUT IS ALWAYS NAMED 'TEST.DAT' FOR NOW.
CX199X CALL OPEN(IDEV,'TEST',0,'NEW',,,'UNF')
199 CALL OFILE(IDEV,'TEST')
99 J=IDSK+1
M1=1
M2=0
IDSK=IDSK+N
C COUNTS SAMPLES TO DATE
DO 1 K=J,IDSK
S=ROUT(M1+M2)
A=ABS(S)
IF(A.GT.PEAK)PEAK=A
IF(CONV.NE.0)S=S*64.
C *64 TO CONVERT 12 BIT AMPL RANGE TO 16 BIT RANGE.
IDBUF(K)=S
1 M2=M2+1
IF(IDSK.LT.NBUF)RETURN
C NBUF=512,MONO =1024,STEREO
IF(CONV.EQ.0)GO TO 11
M=1
J=NBUF/2
DO 44 K=1,J
NN(K)=(IDBUF(M)*"1000000).OR.(IDBUF(M+1).AND."777777)
C PACKS 2 SMPLS PER WORD.
CC NN(K)=IDBUF(M)*262144+IDBUF(M+1)
C 16*262144=4194304
44 M=M+2
CZ IF(MS(L).LT.0)MS(L)=4096+MS(L)
CZ IDBUF(KL)=MS(3)+MS(2)*4096+MS(1)*16777216
C PACKS 3 SMPLS TO A 36-BIT WORD. 4096=2**12, 16---=2**24.
C MS(1) HAS LEFT HAND 12 BITS; MS(2), MIDDLE 12 BITS; MS(3), RIGHT 12.
C NEGATIVE NUMBERS RUN FROM 4095(I.E. -1) TO 2049(I.E. -2048).
C CALL FASTOU(NN,J)
CALL EXTOUT(NN,J)
GO TO 10
11 WRITE(IDEV)JDBUF
IF(NBUF.NE.512)WRITE(IDEV),LDBUF
C ABOVE FOR STEREO
10 J=IDSK-NBUF
IF(J.LT.1)GO TO 4
DO 5 K=1,J
5 IDBUF(K)=IDBUF(NBUF+K)
4 IDSK=J
RETURN
END
CERRO1 GENERAL ERROR ROUTINE *** MUSIC V ***
SUBROUTINE ERROR(I)
COMMON /NDEV/NDEV
WRITE(NDEV,100),I
100 FORMAT (' ERROR OF TYPE',I5/)
RETURN
END